{------------------------------------------------------------------------------- Example1 for working with BDF font This program is part of the BDFfont project. It show how to work with BDF file using BDFfont library. Full project can be found at http://sourceforge.net/projects/bdffont/ Copyright TridenT 2003 - Under GNU GPL licence @Author TridenT @Version 2003/08/11 TridenT v0.1 Initial revision @Version 2003/08/11 TridenT v0.2 Add transparency, space char, hints @Version 2003/08/24 TridenT v0.3 Added progress form (when loading font) @Version 2003/09/05 TridenT v0.4 Added save to BMP function. @Todo -------------------------------------------------------------------------------} unit MainForm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, u_BDFfont, Menus, ComCtrls; type TProjectStatus = (psNew, psFontLoaded, psFontUnloaded); TForm1 = class(TForm) Panel2: TPanel; Button_WriteCanvas: TButton; Edit_TextToWrite: TEdit; Button_LoadBDFfont: TButton; Button_UnloadBDFfont: TButton; PaintBox1: TPaintBox; OpenDialogBDF: TOpenDialog; MainMenu1: TMainMenu; File1: TMenuItem; Quit1: TMenuItem; N1: TMenuItem; About1: TMenuItem; Edit_PixelSpace: TEdit; UpDown_PixelSpace: TUpDown; Label1: TLabel; CheckBox_Transparent: TCheckBox; Button_SaveToFile: TButton; SaveDialogBMP: TSaveDialog; procedure Button_LoadBDFfontClick(Sender: TObject); procedure Button_UnloadBDFfontClick(Sender: TObject); procedure Button_WriteCanvasClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Quit1Click(Sender: TObject); procedure About1Click(Sender: TObject); procedure Edit_PixelSpaceChange(Sender: TObject); procedure CheckBox_TransparentClick(Sender: TObject); procedure PaintBox1DblClick(Sender: TObject); procedure Button_SaveToFileClick(Sender: TObject); private { Private declarations } BDF_font: TBDF_Font; fWait: TForm; procedure UpdateControls(Status: TProjectStatus); procedure OnLoading(Sender: TObject; Value: integer); public { Public declarations } end; var Form1: TForm1; implementation uses About; {$R *.dfm} procedure TForm1.Button_LoadBDFfontClick(Sender: TObject); begin if OpenDialogBDF.Execute then begin BDF_Font := TBDF_Font.Create; BDF_Font.OnFontLoading := OnLoading; // Initialize progress form fWait := CreateMessageDialog('Loading the font, please wait.', mtInformation, []); fWait.Show; BDF_Font.LoadFromFile(OpenDialogBDF.FileName); // Close and free progress form fWait.Close; FreeAndNil(fWait); UpdateControls(psFontLoaded); end; end; procedure TForm1.Button_UnloadBDFfontClick(Sender: TObject); begin FreeAndNil(BDF_Font); UpdateControls(psFontUnloaded); end; procedure TForm1.Button_WriteCanvasClick(Sender: TObject); begin BDF_Font.DrawText(Random(PaintBox1.Canvas.ClipRect.Right div 2) , Random(PaintBox1.Canvas.ClipRect.Bottom), Paintbox1.Canvas, Edit_TextToWrite.Text); end; procedure TForm1.FormCreate(Sender: TObject); begin Randomize; UpdateControls(psNew); Caption := Application.Title; end; // Update buttons and other controls procedure TForm1.UpdateControls(Status: TProjectStatus); begin case Status of psFontLoaded: begin Button_LoadBDFfont.Enabled := False; Button_UnloadBDFfont.Enabled := True; Button_WriteCanvas.Enabled := True; Button_SaveToFile.Enabled := True; Button_SaveToFile.Enabled := True; end; else begin Button_LoadBDFfont.Enabled := True; Button_UnloadBDFfont.Enabled := False; Button_WriteCanvas.Enabled := False; Button_SaveToFile.Enabled := False; Button_SaveToFile.Enabled := False; end; end; // case end; procedure TForm1.Quit1Click(Sender: TObject); begin if Assigned(BDF_Font) then FreeAndNil(BDF_Font); Close; end; procedure TForm1.About1Click(Sender: TObject); begin AboutBox.ShowModal; end; procedure TForm1.Edit_PixelSpaceChange(Sender: TObject); begin if Assigned(BDF_Font) then BDF_Font.PixelSpaceChar := StrToInt(Edit_PixelSpace.Text); end; procedure TForm1.CheckBox_TransparentClick(Sender: TObject); begin if Assigned(BDF_Font) then BDF_Font.IsTransparent := (Sender as TCheckbox).Checked; end; procedure TForm1.PaintBox1DblClick(Sender: TObject); begin PaintBox1.Canvas.Brush.Color := clSkyBlue; PaintBox1.Canvas.FillRect(PaintBox1.Canvas.ClipRect); end; // When loading, show percents loaded procedure TForm1.OnLoading(Sender: TObject; Value: integer); begin if Assigned(fWait) then begin fWait.Caption := IntToStr(Value) + ' %'; Application.ProcessMessages; end; end; procedure TForm1.Button_SaveToFileClick(Sender: TObject); begin if Assigned(BDF_Font) then if SaveDialogBMP.Execute then BDF_Font.SaveToBitmap(SaveDialogBMP.FileName); end; end.