Subversion Repositories stackman

Rev

Go to most recent revision | Blame | Last modification | View Log | RSS feed

  1. unit appender;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls,
  7.   Dialogs, Menus, ImgList, ShellAPI, CheckLst;
  8.  
  9. type
  10.   TMDIAppender = class(TForm)
  11.     newLineEdt: TMemo;
  12.     MainMenu: TMainMenu;
  13.     Document1: TMenuItem;
  14.     Save: TMenuItem;
  15.     ExternalOpen: TMenuItem;
  16.     DocumentClose1: TMenuItem;
  17.     N2: TMenuItem;
  18.     Delete: TMenuItem;
  19.     N3: TMenuItem;
  20.     bottomPanel: TPanel;
  21.     topPanel: TPanel;
  22.     CheckListBox1: TCheckListBox;
  23.     Neuladen1: TMenuItem;
  24.     Stroke: TMenuItem;
  25.     N4: TMenuItem;
  26.     VSplitter: TSplitter;
  27.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  28.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  29.     procedure FormShow(Sender: TObject);
  30.     procedure ExternalOpenClick(Sender: TObject);
  31.     procedure DocumentClose1Click(Sender: TObject);
  32.     procedure SaveClick(Sender: TObject);
  33.     procedure newLineEdtKeyDown(Sender: TObject; var Key: Word;
  34.       Shift: TShiftState);
  35.     procedure DeleteClick(Sender: TObject);
  36.     procedure FormCreate(Sender: TObject);
  37.     procedure CheckListBox1DrawItem(Control: TWinControl;
  38.       Index: Integer; Rect: TRect; State: TOwnerDrawState);
  39.     procedure CheckListBox1MeasureItem(Control: TWinControl;
  40.       Index: Integer; var Height: Integer);
  41.     procedure StrokeClick(Sender: TObject);
  42.     procedure Neuladen1Click(Sender: TObject);
  43.     procedure CheckListBox1Click(Sender: TObject);
  44.     procedure newLineEdtChange(Sender: TObject);
  45.     procedure CheckListBox1KeyPress(Sender: TObject; var Key: Char);
  46.   protected
  47.     function DoAppend: boolean;
  48.     function DoStroke: boolean;
  49.     procedure RefreshList;
  50.   private
  51.     fcat: string;
  52.     fprefix: string;
  53.     procedure ExtendedUpdateCaption;
  54.     function StrokeCount: integer;
  55.   public
  56.     property folder: string read fprefix;
  57.     property cat: string read fcat;
  58.     constructor Create(AOwner: TComponent; Folder, Category: string); reintroduce;
  59.   end;
  60.  
  61. implementation
  62.  
  63. {$R *.dfm}
  64.  
  65. uses
  66.   main, categories, global;
  67.  
  68. constructor TMDIAppender.Create(AOwner: TComponent; Folder, Category: string);
  69. begin
  70.   inherited Create(AOwner);
  71.  
  72.   fcat := category;
  73.   fprefix := MyAddTrailingPathDelimiter(folder);
  74. end;
  75.  
  76. procedure TMDIAppender.FormClose(Sender: TObject; var Action: TCloseAction);
  77. begin
  78.   Action := caFree;
  79. end;
  80.  
  81. function TMDIAppender.DoStroke: boolean;
  82. var
  83.   i: integer;
  84. begin
  85.   AddToJournal(Format(lng_jnl_stroke_from, [folder + cat]));
  86.  
  87.   result := true;
  88.   // TODO: Downto für den Benutzer nicht ganz nachvollziehbar. Aber wichtig für das Löschen.
  89.   for i := CheckListBox1.Items.Count - 1 downto 0 do
  90.   begin
  91.     if CheckListBox1.Checked[i] then
  92.     begin
  93.       try
  94.         AddToJournal(Format('- %s', [CheckListBox1.Items.Strings[i]]));
  95.         StrokeFromFile(getAppenderFileName(folder, cat), i, CheckListBox1.Items.Strings[i]);
  96.         CheckListBox1.Items.Delete(i);
  97.       except
  98.         on E : EStrokeMismatch do
  99.         begin
  100.           result := false;
  101.           ShowMessage(lng_stroke_mismatch);
  102.           CheckListBox1.ItemIndex := i;
  103.           break; exit;
  104.         end;
  105.  
  106.         (* on E : EStrokeUnknown do
  107.         begin
  108.           result := false;
  109.           ShowMessage(lng_stroke_error);
  110.           CheckListBox1.ItemIndex := i;
  111.           break; exit;
  112.         end; *)
  113.  
  114.         else
  115.         begin
  116.           result := false;
  117.           ShowMessage(lng_stroke_error);
  118.           CheckListBox1.ItemIndex := i;
  119.           break; exit;
  120.         end;
  121.       end;
  122.     end;
  123.   end;
  124.  
  125.   Stroke.Enabled := false;
  126.   ExtendedUpdateCaption;
  127. end;
  128.  
  129. function TMDIAppender.DoAppend: boolean;
  130. var
  131.   f: TextFile;
  132.   i: integer;
  133. begin
  134.   AddToJournal(Format(lng_jnl_add_to, [folder + cat]));
  135.  
  136.   result := true;
  137.   try
  138.     AssignFile(f, getAppenderFileName(folder, cat));
  139.     try
  140.       Append(f);
  141.  
  142.       if (newLineEdt.Lines.Count = 0) and (CfgAppenderAllowEmptyLines) then
  143.       begin
  144.         CheckListBox1.Items.Add(newLineEdt.Text{ = ''});
  145.         AddToJournal(Format('+ %s', [newLineEdt.Lines.Text]));
  146.         WriteLn(f, newLineEdt.Lines.Text);
  147.       end
  148.       else
  149.       begin
  150.         for i := 0 to newLineEdt.Lines.Count - 1 do
  151.         begin
  152.           if ((newLineEdt.Lines.Strings[i] = '') and CfgAppenderAllowEmptyLines) or
  153.               (newLineEdt.Lines.Strings[i] <> '') then
  154.           begin
  155.             CheckListBox1.Items.Add(newLineEdt.Lines.Strings[i]);
  156.             AddToJournal(Format('+ %s', [newLineEdt.Lines.Strings[i]]));
  157.             WriteLn(f, newLineEdt.Lines.Strings[i]);
  158.           end;
  159.         end;
  160.       end;
  161.     finally
  162.       CloseFile(f);
  163.     end;
  164.   except
  165.     result := false;
  166.     ShowMessage(lng_error);
  167.   end;
  168.  
  169.   CheckListBox1.TopIndex := CheckListBox1.Items.Count - 1; // Nach unten scrollen
  170. end;
  171.  
  172. procedure TMDIAppender.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  173. var
  174.   userResponse: integer;
  175. begin
  176.   if strokecount > 0 then
  177.   begin
  178.     userResponse := MessageDlg(Format(lng_strokefirst, [strokecount, cat]),
  179.       mtConfirmation, mbYesNoCancel, 0);
  180.  
  181.     case userResponse of
  182.       idYes: CanClose := DoStroke;
  183.       idNo: CanClose := true;
  184.       idCancel: begin
  185.         CanClose := false;
  186.         exit;
  187.       end;
  188.     end;
  189.   end;
  190.  
  191.   if newLineEdt.Text = '' then
  192.   begin
  193.     CanClose := true;
  194.     exit;
  195.   end
  196.   else
  197.   begin
  198.     BringToFront;
  199.     WindowState := wsNormal;
  200.  
  201.     userResponse := MessageDlg(Format(lng_appendfirst, [folder + cat]),
  202.       mtConfirmation, mbYesNoCancel, 0);
  203.     case userResponse of
  204.       idYes: CanClose := DoAppend;
  205.       idNo: CanClose := true;
  206.       idCancel: begin
  207.         CanClose := false;
  208.         exit;
  209.       end;
  210.     end;
  211.   end;
  212. end;
  213.  
  214. procedure TMDIAppender.FormShow(Sender: TObject);
  215. begin
  216.   Caption := Format(lng_editor_title, [folder + cat]);
  217.  
  218.   newLineEdt.Clear;
  219.  
  220.   RefreshList;
  221.  
  222.   Save.Enabled := false;
  223.   ExtendedUpdateCaption;
  224.  
  225.   newLineEdt.SetFocus;
  226. end;
  227.  
  228. procedure TMDIAppender.ExternalOpenClick(Sender: TObject);
  229. var
  230.   fn: string;
  231. begin
  232.   fn := getAppenderFileName(folder, cat);
  233.   commonExternalOpen(fn);
  234. end;
  235.  
  236. procedure TMDIAppender.DocumentClose1Click(Sender: TObject);
  237. begin
  238.   Close;
  239. end;
  240.  
  241. procedure TMDIAppender.SaveClick(Sender: TObject);
  242. begin
  243.   if DoAppend then
  244.   begin
  245.     newLineEdt.Clear;
  246.     Save.Enabled := false;
  247.     ExtendedUpdateCaption;
  248.   end;
  249. end;
  250.  
  251. procedure TMDIAppender.newLineEdtKeyDown(Sender: TObject; var Key: Word;
  252.   Shift: TShiftState);
  253. begin
  254.   if (Key = VK_RETURN) then
  255.   begin
  256.     Key := 0;
  257.     if CfgAppenderAllowEmptyLines and (newLineEdt.Text = '') then
  258.     begin
  259.       Save.Enabled := true;
  260.     end;
  261.     Save.Click;
  262.   end;
  263. end;
  264.  
  265. procedure TMDIAppender.DeleteClick(Sender: TObject);
  266. var
  267.   fn: string;
  268.   i: integer;
  269. begin
  270.   fn := getAppenderFileName(folder, cat);
  271.   if commonDelete(fn) then
  272.   begin
  273.     Close;
  274.  
  275.     // TODO: Eigentlich sollte das innerhalb von commonDelete() stattfinden
  276.     for i := Screen.FormCount - 1 downto 0 do
  277.     begin
  278.       if Screen.Forms[i] is TMDICategories then
  279.       begin
  280.         TMDICategories(Screen.Forms[i]).DeleteNode(folder, cat);
  281.       end
  282.     end;
  283.   end;
  284. end;
  285.  
  286. procedure TMDIAppender.FormCreate(Sender: TObject);
  287. begin
  288.   CheckListBox1.Style := lbOwnerDrawVariable;
  289.   CheckListBox1.Clear;
  290.  
  291.   Stroke.Enabled := false;
  292.  
  293.   ExtendedUpdateCaption;
  294.  
  295.   newLineEdt.Clear;
  296. end;
  297.  
  298. procedure TMDIAppender.RefreshList;
  299. begin
  300.   CheckListBox1.Items.Clear;
  301.   CheckListBox1.Items.LoadFromFile(getAppenderFileName(folder, cat));
  302.   CheckListBox1.TopIndex := CheckListBox1.Items.Count-1; // Nach unten scrollen
  303. end;
  304.  
  305. function TransformDrawingText(s: string): string;
  306. begin
  307.   result := StringReplace(s, #9, '                ', [rfReplaceAll]);     // TODO: gilt nicht für w95...
  308. end;
  309.  
  310. // http://www.delphipraxis.net/post1068742.html#1068742
  311. // Bugfix: Invalidate
  312. // Bugfix: Leere Zeilen
  313.  
  314. procedure TMDIAppender.CheckListBox1DrawItem(Control: TWinControl;
  315.   Index: Integer; Rect: TRect; State: TOwnerDrawState);
  316. begin
  317.   with CheckListbox1.Canvas do
  318.   begin
  319.     FillRect(Rect);
  320.     DrawText(Handle, PChar(TransformDrawingText(CheckListBox1.Items[Index])), -1, Rect, DT_LEFT or DT_TOP or DT_WORDBREAK);
  321.     Invalidate;
  322.   end;
  323. end;
  324.  
  325. procedure TMDIAppender.CheckListBox1KeyPress(Sender: TObject; var Key: Char);
  326. begin
  327.   CheckListBox1Click(self); // z.B. wenn man die Leertaste drückt
  328. end;
  329.  
  330. procedure TMDIAppender.CheckListBox1MeasureItem(Control: TWinControl;
  331.   Index: Integer; var Height: Integer);
  332. var
  333.   tempCanvas: TCanvas;
  334.   notUsed: HWND;
  335.   destRect: TRect;
  336.   txt: PChar;
  337. begin
  338.   tempCanvas := TCanvas.Create;
  339.   try
  340.     tempCanvas.Handle := GetDeviceContext(notUsed);
  341.     destRect := CheckListBox1.ClientRect;
  342.     if CheckListBox1.Items[Index] = '' then
  343.       txt := ' '
  344.     else
  345.       txt := PChar(TransformDrawingText(CheckListBox1.Items[Index]));
  346.     Height := DrawText(tempCanvas.Handle, txt, -1, destRect, DT_WORDBREAK);
  347.   finally
  348.     tempCanvas.Free;
  349.   end;
  350. end;
  351.  
  352. procedure TMDIAppender.StrokeClick(Sender: TObject);
  353. var
  354.   userResponse: integer;
  355. begin
  356.   userResponse := MessageDlg(Format(lng_stroker_really, [StrokeCount]), mtConfirmation, mbYesNoCancel, 0);
  357.  
  358.   if userResponse = idYes then
  359.   begin
  360.     DoStroke;
  361.   end;
  362. end;
  363.  
  364. function TMDIAppender.StrokeCount: integer;
  365. var
  366.   i: integer;
  367. begin
  368.   result := 0;
  369.   for i := 0 to CheckListBox1.Count - 1 do
  370.   begin
  371.     if CheckListBox1.Checked[i] then
  372.     begin
  373.       inc(result);
  374.     end;
  375.   end;
  376. end;
  377.  
  378. procedure TMDIAppender.Neuladen1Click(Sender: TObject);
  379. var
  380.   userResponse: integer;
  381. begin
  382.   userResponse := 0;
  383.  
  384.   if stroke.Enabled then
  385.   begin
  386.     userResponse := MessageDlg(Format(lng_refresh_strokes_loss, [StrokeCount]), mtWarning, mbYesNoCancel, 0);
  387.   end;
  388.  
  389.   if (not stroke.Enabled) or (userResponse = idYes) then
  390.   begin
  391.     CheckListBox1.Visible := false;
  392.     RefreshList;
  393.     CheckListBox1.Visible := true;
  394.   end;
  395. end;
  396.  
  397. procedure TMDIAppender.CheckListBox1Click(Sender: TObject);
  398. var
  399.   i: integer;
  400. begin
  401.   Stroke.Enabled := false;
  402.  
  403.   for i := 0 to CheckListBox1.Count - 1 do
  404.   begin
  405.     if CheckListBox1.Checked[i] then
  406.     begin
  407.       Stroke.Enabled := true;
  408.       break;
  409.     end;
  410.   end;
  411.  
  412.   ExtendedUpdateCaption;
  413. end;
  414.  
  415. procedure TMDIAppender.newLineEdtChange(Sender: TObject);
  416. begin
  417.   Save.Enabled := newLineEdt.Text <> '';
  418.   ExtendedUpdateCaption;
  419. end;
  420.  
  421. procedure TMDIAppender.ExtendedUpdateCaption;
  422. var
  423.   changed: boolean;
  424.   capname: string;
  425. begin
  426.   changed := Save.Enabled or Stroke.Enabled;
  427.  
  428.   capname := Format(lng_editor_title, [folder + cat]);
  429.   if changed then capname := capname + ' *';
  430.  
  431.   if Caption <> capname then Caption := capname; // Kein Aufblitzen
  432. end;
  433.  
  434. end.
  435.